perm filename PASS3.F4[STR,LCS] blob sn#339441 filedate 1978-03-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	CPASS3     PASS 3 MAIN PROGRAM  
C00011 ENDMK
C⊗;
CPASS3     PASS 3 MAIN PROGRAM  
C    *** MUSIC V ***     
C     DATA SPECIFICATION 
      INTEGER PEAK
      DIMENSION T(50),TI(50),ITI(50)   
      COMMON I(15000) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,NRSOR  
	DIMENSION IHD(1)
	EQUIVALENCE (IHD,P(1))
CC*******      DATA IIIRD/Z5EECE66D/     
      DATA IIIRD/976545367/     
C  SET I ARRAY =0 (7/10/69)
      DATA I/15000*0/,I(4)/12800/
C**************
C     INIALIZATION OF PIECE     
C      ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
      I(7)=IIIRD  
      IP9=IP(9)   
      PEAK=0      
      NRSOR=0     
CC*******    NREAD = 3   
CC*******    NWRITE = 2  
      NREAD=21
C   PDP DSK1=DEV.21
      NWRITE=1
C   PDP DSK=DEV.1
      REWIND NREAD
      REWIND NWRITE      
      TYPE 10001
      ACCEPT 10002,FLNM,IDSK
C  TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
      IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
      CALL IFILE(21,FLNM)
      IF(IDSK.NE.0)GO TO 10003
CC    J='MUSAA'
	J='TEST'
      CALL PUTFILE(J)
C  IF IDSK=0, SAMPLES WILL BE WRITTEN ON DSK (TEST.SND)
      IDSK=0
	IHD(1)="525252525252
	IHD(2)=I(4)
C I(4)=SRATE
	IHD(3)=0
C  0=12-BIT
C (4)NCHNS←1 OR 2
	IHD(4)=I(8)+1
	IF(IHD(4).EQ.0)IHD(4)=1
C (5)MAXAMP (FLTING PT.)  (6)=NUM. OF SAMPLES
CC	P(55)=PEAK
	IHD(6)=0
	CALL FASTOU(IHD,128)
C THE HEADER (SUCH AS IT IS)
      GO TO 10002
10003 IDSK=-1
10001 FORMAT(' TYPE FILE NAME'/)
10002 FORMAT(A5,I)
C**** ABOVE FOR PDP IO ********
      SCLFT=IP(12)
      I(2)=IP(4)  
      MS1=IP(7)   
      MS3=MS1+(IP(8)*IP(9))-1   
      MS2=IP(8)   
      I(4)=IP(3)  
      MOUT=IP(10) 
C     INITIALIZATION OF SECTION 
5     T(1)=0.0    
      DO 220N1=MS1,MS3,MS2
 220  I(N1)=-1    
      DO 221N1=1,IP9      
 221  TI(N1)=1000000.    
C     MAIN CARD READING LOOP    
  204 CALL DATA (NREAD)  
      IF(P(2)-T(1))200,200,244  
 200  IOP=P(1)    
      IF(IOP)201,201,202 
 201  CALLERROR(1)
      GO TO 204     
 202  IF(IP(1)-IOP)201,203,203  
 203  GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP    
 11   IVAR=P(3)   
      IVARE=IVAR+I(1)-4  
      DO  297 N1=IVAR,IVARE      
      IVARP=N1-IVAR+4    
 297  I(N1)=P(IVARP)     
      GO TO 204     
 3    IGEN=P(3)   
      GO TO (281,282,283,284,285),IGEN   
 281  CALLGEN1    
      GO TO 204     
 282  CALLGEN2    
      GO TO 204     
 283  CALLGEN3    
      GO TO 204     
 284  CALLGEN4    
      GO TO 204     
 285  CALLGEN5    
      GO TO 204     
 4    IVAR=P(3)   
      IVARE=IVAR+I(1)-4  
      DO 296N1=IVAR,IVARE 
      IVARP=N1-IVAR+4    
 296  I(N1+100)=P(IVARP)*SCLFT  
      GO TO 204     
    6 CALL FROUT3(IDSK)
      STOP 
C     ENTER NOTE TO BE PLAYED   
 1    DO 230N1=MS1,MS3,MS2
      IF(I(N1)+1)230,231,230    
 230  CONTINUE    
      CALLERROR(2)
      GO TO 204     
 231  M1=N1
      M2=N1+I(1)-1
      M3=M2+1     
      M4=N1+IP(8)-1      
      DO 232N1=M1,M2      
      M5=N1-M1+1  
 232  I(N1)=P(M5)*SCLFT  
      I(M1  )=P(3)
      DO 233N1=M3,M4      
 233  I(N1)=0     
      DO 235N1=1,IP9      
      IF(TI(N1)-1000000.)235,234,235   
 234  TI(N1)=P(2)+P(4)   
      ITI(N1)=M1  
      GO TO 204     
 235  CONTINUE    
      CALLERROR(3)
      GO TO 204     
C     DEFINE INSTRUMENT  
 2    M1=I(2)     
      M2=IP(5)+IFIX(P(3))
      I(M2)=M1    
  218 CALL DATA (NREAD)  
      IF(I(1)-2)210,210,211     
 210  I(M1)=0     
      I(2)=M1+1   
      GO TO 204     
 211  I(M1)=P(3)  
      M3=I(1)     
      I(M1+1)=M1+M3-1    
      M1=M1+2     
      DO 217N1=4,M3
      M5=P(N1)    
      IF(M5)212,213,213  
 212  IF(M5+100)300,301,301     
 300  I(M1)=-IP(2)+(M5+101)*IP(6)      
      GO TO 216     
 301  I(M1)=-IP(13)+(M5+1)*IP(14)      
      GO TO 216     
 213  IF(M5- 100 )214,214,215   
 214  I(M1)=M5    
      GO TO 216     
 215  I(M1)=M5+262144    
 216  M1=M1+1     
 217  CONTINUE    
      GO TO 218     
C     PLAY TO ACTION TIME
 244  T(2)=P(2)   
 250  TMIN=1000000.      
      IREST=1     
      DO 241N1=1,IP9      
      IF(TMIN-TI(N1))241,241,240
 240  TMIN=TI(N1) 
      MNOTE=N1    
 241  CONTINUE    
      IF(1000000.-TMIN)251,251,243     
 243  IF(TMIN-T(2))245,245,246  
 245  T(3)=TMIN   
      GO TO 260     
 246  T(3)=T(2)   
      GO TO 260     
 247  IF(T(1)-T(2))249,200,200  
 249  TI(MNOTE)=1000000. 
      M2=ITI(MNOTE)      
      I(M2)=-1    
      GO TO 250     
C     SETUP REST  
 251  T(3)=T(2)   
      IREST=2     
      GO TO 260     
C     PLAY 
 260  ISAM=(T(3)-T(1))*FLOAT(I(4))+.5  
      T(1)=T(3)   
      IF(ISAM)247,247,266
 266  IF(ISAM-IP(14))262,262,263
 262  I(5)=ISAM   
      ISAM=0      
      GO TO 264     
 263  I(5)=IP(14) 
      ISAM=ISAM-IP(14)   
 264  IF(I(8))290,290,291
 290  M3=MOUT+I(5)-1     
      MSAMP=I(5)  
      GO TO 292     
 291  M3=MOUT+(2*I(5))-1 
      MSAMP=2*I(5)
 292  DO 267N1=MOUT,M3    
 267  I(N1)=0     
      GO TO (268,265),IREST
 268  DO 270NS1=MS1,MS3,MS2      
      IF(I(NS1)+1)271,270,271   
C     GO THROUGH UNIT GENERATORS IN INSTRUMENT
 271  I(3)=NS1    
      IGEN=IP(5)+I(NS1)  
      IGEN=I(IGEN)
 272  I(6)=IGEN   
CC*****    IF(I(IGEN)-101)293,294,294
CC***** 293  CALLSAMGEN(I)      
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC*****      GO TO 295     
 294  CALLFORSAM  
 295  IGEN=I(IGEN+1)     
      IF(I(IGEN))270,270,272    
 270  CONTINUE    
 265  CALL SAMOUT(IDSK ,MSAMP)
      IF(ISAM)247,247,266
      END